home *** CD-ROM | disk | FTP | other *** search
/ QRZ! Ham Radio 6 / QRZ Ham Radio Callsign Database - Volume 6.iso / mac / files / f6fbb / cc920724.lzh / CC.PAS < prev    next >
Pascal/Delphi Source File  |  1992-07-24  |  11KB  |  361 lines
  1. program CC;
  2.  
  3. { OH3NWQ                                                  }
  4. { written in turbo pascal 6.0                             }
  5. { tämähän on onneksi vain harrastus (vai olenko väärässä) }
  6. { ja harrastuksenhan voi lopettaa sillä hetkellä kun se   }
  7. { alkaa tuntua työltä ...                                 }
  8. {                                                         }
  9. { I did this programme for my own use...                  }
  10. {                                                         }
  11. { syntax:                                                 }
  12. {          sp cc                                          }
  13. {          The title for all the messages                 }
  14. {          CC: oh3nwq @ oh3rbr.fin.eu                     }
  15. {          CC: ua3lid @ ua3rk.rus.eu                      }
  16. {          The text as you would type it when mailing     }
  17. {          a normal mail...                               }
  18. {          /EX                                            }
  19. {                                                         }
  20. { new on 920715                                           }
  21. {          /7 and /8 commands                             }
  22. {          You can also use CC: /7 and CC: /8             }
  23. {          and the scandinavian/german special characters }
  24. {          will be translated to their 7 (or 8) bit       }
  25. {          representatives.                               }
  26. {          These commands will take effect on the         }
  27. {          callsigns following the CC: /7 line.           }
  28. { new on 920721                                           }
  29. {          Windows characters                             }
  30. { new on 920724                                           }
  31. {          CC: /V verbose mode                            }
  32. {          I.e. copy >CC: lines - default: no copy        }
  33.  
  34. uses DOS;
  35.  
  36. type
  37.     pitkajono = string[80];
  38.     lyhytjono = string[9];
  39.  
  40. var
  41.     mista, mihin,
  42.     missa, tiedot, ots, cc_kutsu       : pitkajono;
  43.     kutsu, lah                         : lyhytjono;
  44.     cc_found, skandi7ksi, skandi8ksi,
  45.     verbose                            : boolean;
  46.     numero                             : integer;
  47.  
  48. const
  49.     copyright = 'Carbon Copy for FBB 5.14 v.1992-07-24 by OH3NWQ @ OH3RBR.FIN.EU';
  50.  
  51.  
  52. function alkunolla(sana : word) : lyhytjono;
  53. var
  54.    jono : lyhytjono;
  55.  
  56. begin
  57.      str(sana:0,jono);
  58.      if length(jono) = 1 then
  59.         jono := '0' + jono;
  60.      alkunolla := jono;
  61. end;
  62.  
  63.  
  64. function muunna7(muunnettava : pitkajono) : pitkajono;
  65.  
  66. var
  67.    laskuri : integer;
  68.    merkki  : char;
  69.    apujono : pitkajono;
  70.  
  71. begin
  72.      apujono := '';
  73.      for laskuri := 1 to length(muunnettava) do
  74.      begin
  75.           merkki := muunnettava[laskuri];
  76.           case merkki of
  77.                          {Finnish}
  78.                          'ä' : merkki := '{';
  79.                          'ö' : merkki := '|';
  80.                          'å' : merkki := '}';
  81.                          'Ä' : merkki := '[';
  82.                          'Ö' : merkki := '\';
  83.                          'Å' : merkki := ']';
  84.  
  85.                          {Danish}
  86.                          'æ' : merkki := '{';
  87.                          'Æ' : merkki := '[';
  88.                          '¢' : merkki := '|';
  89.                          '¥' : merkki := '\';
  90.  
  91.                          {German}
  92.                          'ü' : merkki := '~';
  93.                          'Ü' : merkki := '^';
  94.                          'ß' : merkki := '}';
  95.  
  96.                          {Windows}
  97.                          'Σ' : merkki := '{';
  98.                          '÷' : merkki := '|';
  99.                          'σ' : merkki := '}';
  100.                          '─' : merkki := '[';
  101.                          '╓' : merkki := '\';
  102.                          '┼' : merkki := ']';
  103.  
  104.                       end;
  105.           if (ord(merkki) > 127) then merkki := '*';
  106.           apujono := apujono + merkki;
  107.      end;
  108.      muunna7 := apujono;
  109. end;
  110.  
  111.  
  112. function muunna8(muunnettava : pitkajono) : pitkajono;
  113.  
  114. var
  115.    laskuri : integer;
  116.    merkki  : char;
  117.    apujono : pitkajono;
  118.  
  119. begin
  120.      apujono := '';
  121.      for laskuri := 1 to length(muunnettava) do
  122.      begin
  123.           merkki := muunnettava[laskuri];
  124.           case merkki of '{' : merkki := 'ä';
  125.                          '|' : merkki := 'ö';
  126.                          '}' : merkki := 'å';
  127.                          '[' : merkki := 'Ä';
  128.                          '\' : merkki := 'Ö';
  129.                          ']' : merkki := 'Å';
  130.                          end;
  131.           apujono := apujono + merkki;
  132.      end;
  133.      muunna8 := apujono;
  134. end;
  135.  
  136.  
  137.  
  138. procedure hae_osoite(hmista : pitkajono ; var lah : lyhytjono ;
  139.                      var otsikko : pitkajono);
  140.  
  141. var
  142.    sisaan                           : text;
  143.    ekarivi, tokarivi, apu           : pitkajono;
  144.    paikka, pituus, k, kir, nro, pis : integer;
  145.    merkki                           : char;
  146.  
  147. begin
  148.      assign(sisaan,hmista);
  149.      reset (sisaan);
  150.  
  151.      readln(sisaan,ekarivi);
  152.      readln(sisaan,otsikko);
  153.  
  154.      close (sisaan);
  155.  
  156.      lah       := '';
  157.      paikka    := pos('<',ekarivi);
  158.      pituus    := length(ekarivi);
  159.  
  160.         for k := paikka+1 to pituus do
  161.             begin
  162.                if copy(ekarivi,k,1) > ' ' then
  163.                   lah := lah+copy(ekarivi,k,1);
  164.             end;
  165.  
  166.      if ((length(lah) > 6) or (length(lah) < 4)) then halt(0);
  167.  
  168. end;
  169.  
  170.  
  171. procedure aloita_vastaus(lahettaja,otsikko,kelle,imprtfile,polku : pitkajono);
  172.  
  173. const
  174.      days : array [0..6] of lyhytjono  =
  175.                   ('Sunday','Monday','Tuesday','Wednesday',
  176.                    'Thursday','Friday','Saturday');
  177.  
  178. var
  179.      ulos               : text;
  180.      ho, mi, se, hund,
  181.      ye, mo, da, dow    : word;
  182.  
  183. begin
  184.  
  185.      if fsearch(imprtfile,polku) = '' then
  186.         begin
  187.            assign(ulos,polku+imprtfile);
  188.            rewrite(ulos);
  189.            close(ulos);
  190.         end;
  191.  
  192.      assign(ulos,polku+imprtfile);
  193.      append(ulos);
  194.  
  195.      writeln(ulos,'SP ',kelle,' <',lahettaja);
  196.      writeln(ulos,otsikko);
  197.      writeln(ulos);
  198.      writeln(ulos,copyright);
  199.      gettime(ho,mi,se,hund);
  200.      getdate(ye,mo,da,dow);
  201.      writeln(ulos,'CC sent at ', days[dow],', ',
  202.              ye:0, '-', alkunolla(mo), '-', alkunolla(da),'  ',
  203.              alkunolla(ho),':',alkunolla(mi), ':',alkunolla(se),
  204.              '.',alkunolla(hund));
  205.      writeln(ulos);
  206.      close(ulos);
  207. end;
  208.  
  209.  
  210. procedure kopioi_rivit(mikatied,imprtfile,polku : pitkajono;
  211.                        s7,s8,verbose : boolean);
  212.  
  213. var
  214.      sisaan, ulos : text;
  215.      rivi         : pitkajono;
  216.      nro          : word;
  217.  
  218. begin
  219.      nro := 0;
  220.      assign(ulos,polku+imprtfile);
  221.      append(ulos);
  222.  
  223.      assign(sisaan,mikatied);
  224.      reset (sisaan);
  225.  
  226.      repeat
  227.            begin
  228.                  readln  (sisaan,rivi);
  229.                  nro := nro+1;
  230.                  if not (copy(rivi,1,3) = '/EX') then
  231.                  begin
  232.                       if ((copy(rivi,1,3) = 'CC:') or (nro < 3)) then
  233.                       begin
  234.                            if verbose then
  235.                            begin
  236.                                 rivi := copy(rivi,1,79);
  237.                                 writeln (ulos,'>',rivi);
  238.                            end;
  239.                       end else
  240.                       begin
  241.                            rivi := copy(rivi,1,80);
  242.                            if s7 then rivi := muunna7(rivi);
  243.                            if s8 then rivi := muunna8(rivi);
  244.                            writeln (ulos,rivi);
  245.                       end;
  246.                  end;
  247.            end;
  248.      until (eof(sisaan)) or (copy(rivi,1,3) = '/EX');
  249.  
  250.      writeln(ulos,'/EX');
  251.  
  252.      close  (ulos);
  253.      close  (sisaan);
  254. end;
  255.  
  256.  
  257. procedure find_cc(mikatied : pitkajono ; var numero   : integer ;
  258.                   var cc_kutsu : pitkajono ; var  cc_found,
  259.                   s7, s8, verbose : boolean );
  260. var
  261.      jono   : pitkajono;
  262.      inte   : integer;
  263.      sisaan : text;
  264.  
  265. begin
  266.      assign(sisaan,mikatied);
  267.      reset (sisaan);
  268.  
  269.      for inte := 1 to numero do readln(sisaan,jono);
  270.  
  271.      readln(sisaan,jono);
  272.      close (sisaan);
  273.  
  274.      numero := numero+1;        
  275.  
  276.      if not (copy(jono,1,3) = 'CC:') then
  277.         begin
  278.              cc_found := false;
  279.              exit;
  280.         end;
  281.  
  282.      if (pos('/8',jono) > 0) then
  283.         begin
  284.              cc_found := true;
  285.              cc_kutsu := 'CC';
  286.              s7       := false;
  287.              s8       := true;
  288.              exit;
  289.         end;
  290.  
  291.      if (pos('/7',jono) > 0) then
  292.         begin
  293.              cc_found := true;
  294.              cc_kutsu := 'CC';
  295.              s7       := true;
  296.              s8       := false;
  297.              exit;
  298.         end;
  299.  
  300.      if ((pos('/v',jono) > 0) or (pos('/V',jono) > 0))then
  301.         begin
  302.              cc_found := true;
  303.              cc_kutsu := 'CC';
  304.              verbose  := true;
  305.              exit;
  306.         end;
  307.  
  308.      if pos(',',jono) > 0 then
  309.         begin
  310.              cc_found := false;  {invalid syntax}
  311.              exit;
  312.         end;
  313.  
  314.      if pos('<',jono) > 0 then
  315.         begin
  316.              cc_found := false;  {lähettäjän asematunnuksen vaihto}
  317.              exit;
  318.         end;
  319.  
  320.      cc_kutsu := copy(jono,4,length(jono)-3);
  321.  
  322. end;
  323.  
  324.  
  325. begin   {Pääohjelma}
  326.  
  327.      lah         := '';
  328.      mista       := paramstr(1);
  329.      cc_found    := true;
  330.      skandi7ksi  := false;
  331.      skandi8ksi  := false;
  332.      verbose     := false;
  333.      mihin       := 'MAIL.IN';
  334.      missa       := 'C:\FBB\';
  335.      numero      := 2;           { SP CC < OH3NWQ and TITLE }
  336.      
  337.      if paramcount < 1 then
  338.         begin
  339.              writeln;
  340.              writeln(copyright);
  341.              writeln('CC is a server to be called from a FBB 5.14 mailbox.');
  342.              writeln;
  343.              writeln('You can also use it from dos : CC filename.ext');
  344.              writeln;
  345.              writeln('The input file must be a FBB export file');
  346.              writeln('Output goes to the FBB import file ', missa, mihin);
  347.              halt(0);
  348.         end;
  349.  
  350.  
  351.      hae_osoite(mista,lah,ots);
  352.  
  353.      repeat
  354.           find_cc(mista,numero,cc_kutsu,cc_found,skandi7ksi,skandi8ksi,verbose);
  355.           if ((cc_found) and (cc_kutsu <> 'CC')) then
  356.           begin
  357.                aloita_vastaus(lah,ots,cc_kutsu,mihin,missa);
  358.                kopioi_rivit(mista,mihin,missa,skandi7ksi,skandi8ksi,verbose);
  359.           end;
  360.      until not cc_found;
  361. end.